WetlandIsWet Function

private function WetlandIsWet(wetland, row, col, time) result(wet)

return .TRUE. if wetland is flooded

Arguments

Type IntentOptional Attributes Name
type(grid_integer) :: wetland
integer, intent(in) :: row
integer, intent(in) :: col
type(DateTime), intent(in) :: time

Return Value logical


Variables

Type Visibility Attributes Name Initial
integer, public :: code
integer, public :: i

Source Code

FUNCTION WetlandIsWet   & 
  !
  (wetland,row,col,time)            &
  RESULT (wet)

IMPLICIT NONE
! function arguments 
! Scalar arguments with intent(in):

TYPE (grid_integer):: wetland
INTEGER, INTENT (IN) :: row, col
TYPE (DateTime), INTENT (IN) :: time

!Local scalar:
LOGICAL :: wet
INTEGER :: code
INTEGER :: i

!------------end of declaration------------------------------------------------ 

IF (ALLOCATED (wetland % mat) ) THEN
    code = wetland % mat(row,col)
    wet = .FALSE.

    DO i = 1, SIZE(wetCode)
      IF ( code == wetCode (i) ) THEN
          IF (time >= wetBegin (i) .AND. time <= wetEnd (i) ) THEN
          wet = .TRUE.    
          EXIT
        END IF
      END IF
    END DO
ELSE
    wet = .FALSE.
END IF

END FUNCTION WetlandIsWet